home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / GRAPHICS / GIF / GIFEDIT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-13  |  3KB  |  121 lines
  1. unit GifEdit;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  6.      StdCtrls, ExtCtrls, RzPrgres, GifImg, FileCtrl, DsgnIntf, SysUtils;
  7.  
  8. type
  9.   TGifProperty = class(TClassProperty)
  10.   public
  11.     function GetAttributes: TPropertyAttributes; override;
  12.     procedure Edit; override;
  13.     procedure SetValue(const Value: String);
  14.     function GetValue: String;
  15.   end;
  16.  
  17.   TGifPropertyClass = class of TGifProperty;
  18.  
  19.   TGifForm = class(TForm)
  20.     OKBtn: TBitBtn;
  21.     CancelBtn: TBitBtn;
  22.     FileBevel: TBevel;
  23.     DriveList: TDriveComboBox;
  24.     DirectoryList: TDirectoryListBox;
  25.     FileList: TFileListBox;
  26.     FilePanel: TPanel;
  27.     LoadProgress: TRzProgressBar;
  28.     GifImageCtl: TGifImage;
  29.     procedure FileListChange(Sender: TObject);
  30.     procedure BtnClick(Sender: TObject);
  31.     procedure GifImageCtlStatusChange(Sender: TObject; Status: TGifStatus);
  32.   private
  33.     { Private declarations }
  34.     function Execute(CurrentFile: TFileName): TModalResult;
  35.   public
  36.     { Public declarations }
  37.   end;
  38.  
  39.   TValidDrives = set of Char;
  40.  
  41. var
  42.   GifForm: TGifForm;
  43.   GifImageCtl: TGifImage;
  44.   GifFileName: String;
  45.   GifResult: TModalResult;
  46.  
  47. const
  48.   GifRect: TRect = (Left: 190; Top: 35; Right: 341 + 190; Bottom: 271 + 35);
  49.   ValidDrives: TValidDrives = ['A','B','C','D','E','F','G','H','I','J','K','L','M',
  50.                                'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'];
  51. implementation
  52.  
  53. {$R *.DFM}
  54.  
  55. function TGifProperty.GetAttributes: TPropertyAttributes;
  56. begin
  57.    Result := [paDialog];
  58. end;
  59.  
  60. procedure TGifProperty.Edit;
  61. begin
  62.    GifForm := TGifForm.Create(Application);
  63.    with GifForm do
  64.    try
  65.       GifFileName := GetValue;
  66.       if Execute(GifFileName) = mrOK then
  67.         SetValue(GifFileName);
  68.    finally
  69.       Free;
  70.    end;
  71. end;
  72.  
  73. procedure TGifProperty.SetValue(const Value: String);
  74. begin
  75.   TGif(GetOrdValue).LoadFromFile(Value);
  76. end;
  77.  
  78. function TGifProperty.GetValue: String;
  79. begin
  80.   Result := TGif(GetOrdValue).FileName;
  81. end;
  82.  
  83. procedure TGifForm.FileListChange(Sender: TObject);
  84. begin
  85.   FilePanel.Caption := FileList.FileName;
  86.   if FileExists(FileList.FileName) then
  87.     GifImageCtl.Gif.LoadFromFile(FileList.FileName);
  88. end;
  89.  
  90. function TGifForm.Execute(CurrentFile: TFileName): TModalResult;
  91. var
  92.   Drv: Char;
  93. begin
  94.   Drv := UpperCase(CurrentFile)[1];
  95.   if FileExists(CurrentFile) then
  96.   begin
  97.     if Drv in ValidDrives then
  98.       DriveList.Drive := CurrentFile[1];
  99.     DirectoryList.Directory := ExtractFilePath(CurrentFile);
  100.     if FileList.Items.IndexOf(ExtractFileName(CurrentFile)) >= 0 then
  101.       FileList.FileName := ExtractFileName(CurrentFile);
  102.   end;
  103.   ShowModal;
  104.   Result := GifResult;
  105. end;
  106.  
  107. procedure TGifForm.BtnClick(Sender: TObject);
  108. begin
  109.   GifResult := TBitBtn(Sender).ModalResult;
  110.   GifFileName := FileList.FileName;
  111.   Close;
  112. end;
  113.  
  114. procedure TGifForm.GifImageCtlStatusChange(Sender: TObject;
  115.   Status: TGifStatus);
  116. begin
  117.   LoadProgress.PartsComplete := Status;
  118. end;
  119.  
  120. end.
  121.